(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * In addition to the permissions granted to you by the LGPL, you may combine
 * or link a "work that uses the Library" with a publicly distributed version
 * of this file to produce a combined library or application, then distribute
 * that combined work under the terms of your choosing, with no requirement
 * to comply with the obligations normally placed on you by section 4 of the
 * LGPL version 3 (or the corresponding section of a later version of the LGPL
 * should you choose to use a later version).
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)

type lex_tables
type lexbuf

(** *)

(* caml_lex_array("abcd") *)
(* [25185, 25699] *)
(* @param s *)
(* @returns {any[]} *)

[%%mel.raw
{|

/***********************************************************************/
/*                                                                     */
/*                           Objective Caml                            */
/*                                                                     */
/*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
/*                                                                     */
/*  Copyright 1996 Institut National de Recherche en Informatique et   */
/*  en Automatique.  All rights reserved.  This file is distributed    */
/*  under the terms of the GNU Library General Public License, with    */
/*  the special exception on linking described in file ../LICENSE.     */
/*                                                                     */
/***********************************************************************/

/* $Id: lexing.c 6045 2004-01-01 16:42:43Z doligez $ */

/* The table-driven automaton for lexers generated by camllex. */

function caml_lex_array(s) {
    var l = s.length / 2;
    var a = new Array(l);
    // when s.charCodeAt(2 * i + 1 ) > 128 (0x80)
    // a[i] < 0
    // for(var i = 0 ; i <= 0xffff; ++i) { if (i << 16 >> 16 !==i){console.log(i<<16>>16, 'vs',i)}}
    //
    for (var i = 0; i < l; i++)
        a[i] = (s.charCodeAt(2 * i) | (s.charCodeAt(2 * i + 1) << 8)) << 16 >> 16;
    return a;
}
|}]

(**
 * external c_engine  : lex_tables -> int -> lexbuf -> int
 * lexing.ml
 * type lex_tables = {
 *   lex_base : string;
 *   lex_backtrk : string;
 *   lex_default : string;
 *   lex_trans : string;
 *   lex_check : string;
 *   lex_base_code : string;
 *   lex_backtrk_code : string;
 *   lex_default_code : string;
 *   lex_trans_code : string;
 *   lex_check_code : string;
 *   lex_code : string;
 * }
 *
 * type lexbuf = {
 *   refill_buff : lexbuf -> unit ;
 *   mutable lex_buffer : bytes;
 *   mutable lex_buffer_len : int;
 *   mutable lex_abs_pos : int;
 *   mutable lex_start_pos : int;
 *   mutable lex_curr_pos : int;
 *   mutable lex_last_pos : int;
 *   mutable lex_last_action : int;
 *   mutable lex_eof_reached : bool;
 *   mutable lex_mem : int array;
 *   mutable lex_start_p : position;
 *   mutable lex_curr_p;
 * }
 * @param tbl
 * @param start_state
 * @param lexbuf
 * @returns {any}
 *)
let caml_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int =
  [%raw
    {|function (tbl, start_state, lexbuf, exn){

    if (!Array.isArray(tbl.lex_default)) {
        tbl.lex_base = caml_lex_array(tbl.lex_base);
        tbl.lex_backtrk = caml_lex_array(tbl.lex_backtrk);
        tbl.lex_check = caml_lex_array(tbl.lex_check);
        tbl.lex_trans = caml_lex_array(tbl.lex_trans);
        tbl.lex_default = caml_lex_array(tbl.lex_default);
    }
    var c;
    var state = start_state;
    //var buffer = bytes_of_string(lexbuf.lex_buffer);
    var buffer = lexbuf.lex_buffer;
    if (state >= 0) {
        /* First entry */
        lexbuf.lex_last_pos = lexbuf.lex_start_pos = lexbuf.lex_curr_pos;
        lexbuf.lex_last_action = -1;
    }
    else {
        /* Reentry after refill */
        state = -state - 1;
    }
    for (;;) {
        /* Lookup base address or action number for current state */
        var base = tbl.lex_base[state];
        if (base < 0)
            return -base - 1;
        /* See if it's a backtrack point */
        var backtrk = tbl.lex_backtrk[state];
        if (backtrk >= 0) {
            lexbuf.lex_last_pos = lexbuf.lex_curr_pos;
            lexbuf.lex_last_action = backtrk;
        }
        /* See if we need a refill */
        if (lexbuf.lex_curr_pos >= lexbuf.lex_buffer_len) {
            if (lexbuf.lex_eof_reached === 0)
                return -state - 1;
            else
                c = 256;
        }
        else {
            /* Read next input char */
            c = buffer[lexbuf.lex_curr_pos];
            lexbuf.lex_curr_pos++;
        }
        /* Determine next state */
        if (tbl.lex_check[base + c] === state) {
            state = tbl.lex_trans[base + c];
        }
        else {
            state = tbl.lex_default[state];
        }
        /* If no transition on this char, return to last backtrack point */
        if (state < 0) {
            lexbuf.lex_curr_pos = lexbuf.lex_last_pos;
            if (lexbuf.lex_last_action == -1)
              throw exn;
            else
                return lexbuf.lex_last_action;
        }
        else {
            /* Erase the EOF condition only if the EOF pseudo-character was
             consumed by the automaton (i.e. there was no backtrack above)
             */
            if (c == 256)
                lexbuf.lex_eof_reached = 0;
        }
    }
}
|}]

let empty_token_lit = "lexing: empty token"

let caml_lex_engine : lex_tables -> int -> lexbuf -> int =
 fun tbls i buf -> caml_lex_engine_aux tbls i buf (Failure empty_token_lit)

[%%mel.raw
{|


/***********************************************/
/* New lexer engine, with memory of positions  */
/***********************************************/

/**
 * s -> Lexing.lex_tables.lex_code
 * mem -> Lexing.lexbuf.lex_mem (* int array *)
 */

function caml_lex_run_mem(s, i, mem, curr_pos) {
    for (;;) {
        var dst = s.charCodeAt(i);
        i++;
        if (dst == 0xff)
            return;
        var src = s.charCodeAt(i);
        i++;
        if (src == 0xff)
            mem[dst] = curr_pos;
        else
            mem[dst] = mem[src];
    }
}


/**
 * s -> Lexing.lex_tables.lex_code
 * mem -> Lexing.lexbuf.lex_mem (* int array *)
 */

function caml_lex_run_tag(s, i, mem) {
    for (;;) {
        var dst = s.charCodeAt(i);
        i++;
        if (dst == 0xff)
            return;
        var src = s.charCodeAt(i);
        i++;
        if (src == 0xff)
            mem[dst] = -1;
        else
            mem[dst] = mem[src];
    }
}
|}]

(**
 * external c_new_engine : lex_tables -> int -> lexbuf -> int = "caml_new_lex_engine"
 * @param tbl
 * @param start_state
 * @param lexbuf
 * @returns {any}
 *)

let caml_new_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int =
  [%raw
    {|function (tbl, start_state, lexbuf, exn) {

    if (!Array.isArray(tbl.lex_default)) {
        tbl.lex_base = caml_lex_array(tbl.lex_base);
        tbl.lex_backtrk = caml_lex_array(tbl.lex_backtrk);
        tbl.lex_check = caml_lex_array(tbl.lex_check);
        tbl.lex_trans = caml_lex_array(tbl.lex_trans);
        tbl.lex_default = caml_lex_array(tbl.lex_default);
    }
    if(!Array.isArray(tbl.lex_default_code)){
        tbl.lex_base_code = caml_lex_array(tbl.lex_base_code);
        tbl.lex_backtrk_code = caml_lex_array(tbl.lex_backtrk_code);
        tbl.lex_check_code = caml_lex_array(tbl.lex_check_code);
        tbl.lex_trans_code = caml_lex_array(tbl.lex_trans_code);
        tbl.lex_default_code = caml_lex_array(tbl.lex_default_code);
    }
    var c, state = start_state;
    //var buffer = caml_bytes_of_string(lexbuf.lex_buffer);
    var buffer = lexbuf.lex_buffer;
    if (state >= 0) {
        /* First entry */
        lexbuf.lex_last_pos = lexbuf.lex_start_pos = lexbuf.lex_curr_pos;
        lexbuf.lex_last_action = -1;
    }
    else {
        /* Reentry after refill */
        state = -state - 1;
    }
    for (;;) {
        /* Lookup base address or action number for current state */
        var base = tbl.lex_base[state];
        if (base < 0) {
            var pc_off = tbl.lex_base_code[state];
            caml_lex_run_tag(tbl.lex_code, pc_off, lexbuf.lex_mem);
            return -base - 1;
        }
        /* See if it's a backtrack point */
        var backtrk = tbl.lex_backtrk[state];
        if (backtrk >= 0) {
            var pc_off = tbl.lex_backtrk_code[state];
            caml_lex_run_tag(tbl.lex_code, pc_off, lexbuf.lex_mem);
            lexbuf.lex_last_pos = lexbuf.lex_curr_pos;
            lexbuf.lex_last_action = backtrk;
        }
        /* See if we need a refill */
        if (lexbuf.lex_curr_pos >= lexbuf.lex_buffer_len) {
            if (lexbuf.lex_eof_reached == 0)
                return -state - 1;
            else
                c = 256;
        }
        else {
            /* Read next input char */
            c = buffer[lexbuf.lex_curr_pos];
            lexbuf.lex_curr_pos++;
        }
        /* Determine next state */
        var pstate = state;
        if (tbl.lex_check[base + c] == state)
            state = tbl.lex_trans[base + c];
        else
            state = tbl.lex_default[state];
        /* If no transition on this char, return to last backtrack point */
        if (state < 0) {
            lexbuf.lex_curr_pos = lexbuf.lex_last_pos;
            if (lexbuf.lex_last_action == -1)
              throw exn;
            else
                return lexbuf.lex_last_action;
        }
        else {
            /* If some transition, get and perform memory moves */
            var base_code = tbl.lex_base_code[pstate], pc_off;
            if (tbl.lex_check_code[base_code + c] == pstate)
                pc_off = tbl.lex_trans_code[base_code + c];
            else
                pc_off = tbl.lex_default_code[pstate];
            if (pc_off > 0)
                caml_lex_run_mem(tbl.lex_code, pc_off, lexbuf.lex_mem, lexbuf.lex_curr_pos);
            /* Erase the EOF condition only if the EOF pseudo-character was
             consumed by the automaton (i.e. there was no backtrack above)
             */
            if (c == 256)
                lexbuf.lex_eof_reached = 0;
        }
    }
    }
|}]

let caml_new_lex_engine : lex_tables -> int -> lexbuf -> int =
 fun tbl i buf -> caml_new_lex_engine_aux tbl i buf (Failure empty_token_lit)
